home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 9 / CDACTUAL9.iso / share / Dos / VARIOS / pascal / MAIL.SWG / 0001_Decode MIME (Base64) Files.pas next >
Encoding:
Pascal/Delphi Source File  |  1996-02-21  |  2.3 KB  |  114 lines
  1. {
  2.  JD> This 'base64' encoding is new to me. Anybody out there who has an
  3.  JD> algorithm or code.
  4.  
  5. === UNBASE64.PAS
  6. { Decode base-64 files, Arne de Bruijn, 1996, Released to the Public Domain }
  7. { Strip everything but the base-64 lines before feeding it into this program }
  8. uses dos;
  9. var
  10.  Base64:array[43..122] of byte;
  11. var
  12.  T:text;
  13.  Chars:set of char;
  14.  S:string;
  15.  K,I,J:word;
  16.  Buf:pointer;
  17.  DShift:integer;
  18.  F:file;
  19.  B,B1:byte;
  20.  Decode:array[0..63] of byte;
  21.  Shift2:byte;
  22.  Size,W:word;
  23. begin
  24.  FillChar(Base64,SizeOf(Base64),255);
  25.  J:=0;
  26.  for I:=65 to 90 do
  27.   begin
  28.    Base64[I]:=J;
  29.    Inc(J);
  30.   end;
  31.  for I:=97 to 122 do
  32.   begin
  33.    Base64[I]:=J;
  34.    Inc(J);
  35.   end;
  36.  for I:=48 to 57 do
  37.   begin
  38.    Base64[I]:=J;
  39.    Inc(J);
  40.   end;
  41.  Base64[43]:=J; Inc(J);
  42.  Base64[47]:=J; Inc(J);
  43.  if ParamCount=0 then
  44.   begin
  45.    WriteLn('UNBASE64 <mime file> [<output file>]');
  46.    Halt(1);
  47.   end;
  48.  S:=ParamStr(1);
  49.  assign(T,S);
  50.  GetMem(Buf,32768);
  51.  SetTextBuf(T,Buf^,32768);
  52.  {$I-} reset(T); {$I+}
  53.  if IOResult<>0 then
  54.   begin
  55.    WriteLn('Error reading ',S);
  56.    Halt(1);
  57.   end;
  58.  if ParamCount>=2 then
  59.   S:=ParamStr(2)
  60.  else
  61.   begin write('Destination:'); ReadLn(S); end;
  62.  assign(F,S);
  63.  {$I-} rewrite(F,1); {$I+}
  64.  if IOResult<>0 then
  65.   begin
  66.    WriteLn('Error creating ',S);
  67.    Halt(1);
  68.   end;
  69.  while not eof(T) do
  70.   begin
  71.    ReadLn(T,S);
  72.    if (S<>'') and (pos(' ',S)=0) and (S[1]>=#43) and (S[1]<=#122) and
  73.     (Base64[byte(S[1])]<>255) then
  74.     begin
  75.      FillChar(Decode,SizeOf(Decode),0);
  76.      DShift:=0;
  77.      J:=0; Shift2:=1;
  78.      Size:=255;
  79.      B:=0;
  80.      for I:=1 to Length(S) do
  81.       begin
  82.        case S[I] of
  83.         #43..#122:B1:=Base64[Ord(S[I])];
  84.        else
  85.         B1:=255;
  86.        end;
  87.        if B1=255 then
  88.         if S[I]='=' then
  89.          begin
  90.           B1:=0; if Size=255 then Size:=J;
  91.          end
  92.         else
  93.          WriteLn('Char error:',S[I],' (',Ord(S[I]),')');
  94.        if DShift and 7=0 then
  95.         begin
  96.          Decode[J]:=byte(B1 shl 2);
  97.          DShift:=2;
  98.         end
  99.        else
  100.         begin
  101.          Decode[J]:=Decode[J] or Hi(word(B1) shl (DShift+2));
  102.          Decode[J+1]:=Lo(word(B1) shl (DShift+2));
  103.          Inc(J);
  104.          Inc(DShift,2);
  105.         end;
  106.       end;
  107.      if Size=255 then Size:=J;
  108.      BlockWrite(F,Decode,Size);
  109.     end;
  110.   end;
  111.  Close(F);
  112.  close(T);
  113. end.
  114.